Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/lang_ext/vbawk/vb-awk.bas

BASIC Source File | 1994-08-15 | 8.7 KB | 333 lines

Global FNR As Long       'File Number of Records
Global NR  As Long       'Number of Records
Global NF As Integer     'Number of Files
Global FILENAME As String   'Name of current file
Global STATUSBOX As Integer 'Flag; if TRUE, indicates the app wishes to activate the built-in statusbox
Global STATUSFILE As Integer 'Flag; if TRUE, indicates that WriteToStatus will write to a file called VB-AWK.LOG
Global STATUSMESSAGES As Integer  'flag; if TRUE, indicates the app wishes to activate the built-in status messages "Processing...finished"
Global APPNAME As String    'Name of application
Global BINARYMODE As Integer    'Flag indicating binary file mode
Global RECLEN As Long           'holds record length for binary reads
Global COMPAREMODE As Integer   'holds global comparison mode, 0 = case-sensitive, 1 = case-insensitive
Global ABORT As Integer         'indicates stop processing right now!

'Constants:
Global Const COMPARE_CASESENSITIVE = 0
Global Const COMPARE_CASEINSENSITIVE = 1

'Locals:
Dim VerNum As String        'VB-AWK version number

Sub AppendToStatus (AppendStr$)
    If STATUSBOX Then
        Ndx% = Status.List1.ListCount - 1
        Status.List1.List(Ndx%) = Status.List1.List(Ndx%) & AppendStr$
        DoEvents
    End If
    If STATUSFILE Then
        Seek #3, (Seek(3) - 2)   'seek prior to preceeding cr/lf
        Print #3, AppendStr$
    End If
End Sub

Sub DoAFile (TheFile As String)
    Dim TheLine As String

    If ABORT Then
        Exit Sub
    End If
    If STATUSMESSAGES Then
        WriteToStatus "Processing: " & TheFile & "..."
    End If
    NF = NF + 1
    FILENAME = TheFile
    FNR = 0

    'Call the user hook for pre-file processing
    If Not BeforeAFile() Then
        'User hook has specified skipping this file
        GoTo Finished2
    End If
    On Error GoTo badopen
    If BINARYMODE Then
        Open TheFile For Binary As #1
    Else
        Open TheFile For Input As #1
    End If
    On Error GoTo BadTempOpen
    TempFile$ = "\xyzzy.tmp"
    If BINARYMODE Then
        Open TempFile$ For Binary As #2
    Else
        Open TempFile$ For Output As #2
    End If

    'do the file
    On Error GoTo Finished
    While 1
        If BINARYMODE Then
            TheLine = Input$(RECLEN, #1)
            If TheLine = "" Then GoTo Finished
        Else
            Line Input #1, TheLine
        End If
        FNR = FNR + 1
        NR = NR + 1
        If DoALine(TheLine) Then
            If BINARYMODE Then
                Put #2, , TheLine
            Else
                Print #2, TheLine
            End If
        End If
    Wend

badopen:
    AppendToStatus "ERROR '" & Error$ & "' OPENING FILE "
    Exit Sub

BadTempOpen:
    AppendToStatus "ERROR '" & Error$ & "' OPENING TEMP FILE \XYZZY.TMP "
    Close #1
    Exit Sub

Finished:
    Close #1
    Close #2
    FileCopy TempFile$, TheFile
    Kill TempFile$
    'fall through

Finished2:
    If STATUSMESSAGES Then
        AppendToStatus "Finished."
    End If
    AfterAFile
    DoEvents
    Exit Sub

End Sub

Sub DoDirectory (TheDir As String)
    Dim Files() As String

    If Right$(TheDir, 1) = "\" Then
        CorrectedDir$ = TheDir
    Else
        CorrectedDir$ = TheDir & "\"
    End If
    NumFiles% = ListAllFiles(Files(), CorrectedDir$ & MultiOpen.Pattern.Text)
    For i% = 0 To (NumFiles% - 1)
        If ABORT Then
            Exit Sub
        End If
        FullFileName$ = CorrectedDir$ & Files(i%)
        If GetAttr(FullFileName$) And ATTR_DIRECTORY Then
            DoDirectory FullFileName$
        Else
            DoAFile FullFileName$
        End If
    Next i%
End Sub

'This function lists all the files and subdirectories in a directory,
'and returns them in the array FilesArray.  FilesArray is a variable-
'size array of strings which must be of size 0 upon entry to this
'routine.
Function ListAllFiles (FilesArray() As String, Pattern As String) As Integer
    Dim Count As Integer        'how many files processed so far
    Dim ArraySize As Integer    'size of files array
    Dim ArrayInc As Integer     'amount to increment array size

    ArrayInc = 5
    CurFile$ = Dir$(Pattern, ATTR_DIRECTORY)
    While CurFile$ <> ""
        'Resize array if necessary.  We resize the array in increments
        'of a size held in ArrayInc.
        If Count >= ArraySize Then
            ArraySize = ArraySize + ArrayInc
            ReDim Preserve FilesArray(ArraySize - 1)
        End If

        'Copy current file into array
        If CurFile$ <> "." And CurFile$ <> ".." Then
            FilesArray(Count) = CurFile$
            Count = Count + 1
        End If

        'one more time...
        CurFile$ = Dir$
    Wend
    ListAllFiles = Count
End Function

Sub Main ()
    VerNum = "VB-AWK Version 1.0"
    APPNAME = "VB-AWK"
    STATUSBOX = True
    STATUSMESSAGES = True
    If Not BeforeAllFiles() Then  'call user preprocessing routine
        End
    End If
    If Command$ = "" Then
        'no command line, so show file-select dialog
        MultiOpen.Show 1
        If STATUSBOX Then
            Status.Show
        End If
        If STATUSFILE Then
            OpenLogFile
        End If
        If MultiOpen.ExpandDirectories.Value = 1 Then
            GoSub RecurseDirectories
        Else
            GoSub DoFiles
        End If
    Else
        'found command line, process it
        If STATUSBOX Then
            Status.Show
        End If
        If Left$(Command$, 1) = "@" Then
            GoSub ProcessListFile
        Else
            GoSub ProcessFileSpec
        End If
    End If

    'finished; final cleanup
    AfterAllFiles
    If STATUSBOX Then
        Status.StopBtn.Enabled = False
    End If
    If STATUSMESSAGES Then
        If ABORT Then
            WriteToStatus "Processing terminated by user."
        Else
            If NF <> 1 Then
                FileOrFiles$ = " files!"
            Else
                FileOrFiles$ = " file!"
            End If
            WriteToStatus "Finished processing " & NF & FileOrFiles$
        End If
    End If
    If STATUSFILE Then
        Close #3
    End If
    Exit Sub

RecurseDirectories:
    DoDirectory (MultiOpen.File1.Path)
    Return

DoFiles:
    If Mid$(MultiOpen.File1.Path, Len(MultiOpen.File1.Path), 1) <> "\" Then
        CorrectedPath = MultiOpen.File1.Path & "\"
    Else
        CorrectedPath = MultiOpen.File1.Path
    End If
    For i% = 0 To MultiOpen.File1.ListCount - 1
        If MultiOpen.File1.Selected(i%) Then
            CurFile$ = CorrectedPath & MultiOpen.File1.List(i%)
            DoAFile CurFile$
        End If
    Next i%
    Return

ProcessListFile:
    On Error GoTo BadListOpen
    ListFileName$ = Mid$(Command$, 2)
    Open ListFileName$ For Input As #10
    On Error GoTo ListFinished
    While True
        Line Input #10, TheFile$
        DoAFile TheFile$
    Wend
    Close #10
    Return

ProcessFileSpec:
    On Error GoTo BadSpec
    SplitFilePath Command$, Drive$, Dirs$, Unused1$, Unused2$
    TheFile$ = Dir$(Command$)
    While TheFile$ <> ""
        If Drive$ <> "" Then
            Colon$ = ":"
        Else
            Colon$ = ""
        End If
        If Dirs$ <> "" Then
            Slash$ = "\"
        Else
            Slash$ = ""
        End If
        DoAFile Drive$ & Colon$ & Dirs$ & Slash$ & TheFile$
        TheFile$ = Dir$
    Wend
    Return

BadSpec:
    MsgBox "Error on file spec: " & Error$
    Exit Sub

BadListOpen:
    MsgBox "Couldn't open list file " & Command$ & ", error: " & Error$
    Exit Sub

ListFinished:
    Close #10
    Return

End Sub

Sub OpenLogFile ()
    On Error GoTo badlogopen
    Open "VB-AWK.LOG" For Output As #3
    Exit Sub

badlogopen:
    MsgBox "Error opening log file; will not use it."
    STATUSFILE = False
    Exit Sub
End Sub

Sub SaveListBox (FilNam As String, LB As ListBox)
    On Error GoTo badsaveopen
    Open FilNam For Output As #5
    On Error GoTo BadWrite
    For i% = 0 To LB.ListCount - 1
        Print #5, LB.List(i%)
    Next i%
    Close #5
    Exit Sub

BadWrite:
    MsgBox "Error: " & Error$ & " writing to file " & FilNam
    Close #5
    Exit Sub

badsaveopen:
    MsgBox "Error: " & Error$ & " opening file " & FilNam
    Exit Sub
End Sub

Sub WriteToStatus (TheStr As String)
    On Error GoTo memerr
    If STATUSBOX Then
        Status.List1.AddItem TheStr
        Status.List1.ListIndex = Status.List1.ListCount - 1
        DoEvents
    End If
    If STATUSFILE Then
        Print #3, TheStr
    End If
    Exit Sub

memerr:
    MsgBox "Status box out of memory; will clear it and continue."
    Status.List1.Clear
    Exit Sub
End Sub